home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / tpu60.arc / TPU6AMS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-01  |  25KB  |  719 lines
  1. {$D+,O+,S+,R-,L+}
  2. Unit TPU6AMS;
  3.  
  4. (*****************)
  5. (**) INTERFACE (**)             USES Dos;
  6. (*****************)
  7.  
  8. TYPE
  9.  
  10.   Str2   = String[2]; Str4 = String[4];
  11.   RngB   = 0..65534;
  12.   RngW   = 0..32766;
  13.   AryB   = ARRAY[rngb] OF Byte;
  14.   AryW   = ARRAY[rngw] OF Word;
  15.   SrcNam = String[12];
  16.   LexNam = String[63];
  17.  
  18.   HdrAry = ARRAY[0..3] OF Char;
  19.  
  20.   LL  = Word;               { Local Scope Pointers (offsets) }
  21.  
  22.   LG  = RECORD              { Global Scope Pointers to Other Units }
  23.              UntLL : LL;    { Local to containing unit }
  24.              UntId : LL;    { Local to  external  unit }
  25.         END;
  26.  
  27.   { The following Record is the Header and Locator for a Unit File } {.CP28}
  28.  
  29.   UnitPtr = ^UnitHeader;
  30.   UnitHeader = RECORD
  31.     UHEYE : HdrAry;        { +00 : = 'TPU9'                     }
  32.     UHxxx : HdrAry;        { +04 : = $00000000                  }
  33.     UHUDH : LL;        { +08 : to Dictionary Head-This Unit }
  34.     UHIHT : LL;        { +0A : to Interface Hash Header     }
  35.     UHPMT : LL;        { +0C : to PROC Map                  }
  36.     UHCMT : LL;        { +0E : to CSeg Map                  }
  37.     UHTMT : LL;        { +10 : to DSeg Map-Typed CONST's    }
  38.     UHDMT : LL;        { +12 : to DSeg Map-GLOBAL Variables }
  39.     UHxxy : LL;        { +14 : purpose unknown              }
  40.     UHLDU : LL;        { +16 : to Donor Unit List           }
  41.     UHLSF : LL;        { +18 : to Source File List          }
  42.     UHDBT : LL;             { +1A : DEBUG Trace Table            }
  43.     UHENC : LL;          { +1C : to end non-code part of Unit }
  44.     UHZCS : Word;        { +1E : CSEG Size-Aggregate          }
  45.     UHZDT : Word;        { +20 : DSEG Size-Typed CONSTS Only  }
  46.     UHZFA : Word;        { +22 : Fix-Up Size (Aggregate)      }
  47.     UHZFT : Word;        { +24 : Fix-Up Size (Typed CONST's)  }
  48.     UHZFV : Word;           { +26 : DSEG Size for Global VARs    }
  49.     UHDHT : LL;        { +28 : to Global Hash Header        }
  50.         UHSOV : Word;           { +2A : Overlay Controls             }
  51.     UHPad : ARRAY[0..9]
  52.         OF Word;    { +2C : Reserved for Future Expansion ? }
  53.  
  54.   END; { UnitHeader }
  55.  
  56.   { The Records below provide access to the PROC Map }        {.CP12}
  57.  
  58.     PMapRecPtr  = ^PMapRec;
  59.     PMapRec = RECORD
  60.                 ProcWd1,
  61.                 ProcWd2 : Word; { function of these words unknown       }
  62.         CSegOfs : Word;    { offset within CSeg Map; $FFFF if null }
  63.         CSegJmp : Word;    { offset to entry point;  $FFFF if null }
  64.     END {PMapRec};
  65.  
  66.     PMapPtr = ^PMapTab;
  67.     PMapTab =  ARRAY[0..1] OF PMapRec; { model of PROC Map }
  68.  
  69.   { The Records below provide access to the CODE Map }        {.CP12}
  70.  
  71.     CMapRecPtr = ^CMapRec;
  72.     CMapRec = RECORD
  73.         CSegWd0 : Word;    { purpose is unknown              }
  74.         CSegCnt : Word;    { byte count of module code       }
  75.         CSegRel : Word;    { byte count of module Relo List  }
  76.         CSegTrc : Word;    { Trace table offset or $FFFF     }
  77.     END; {CMapRec}
  78.  
  79.     CMapTabPtr = ^CMapTab;
  80.     CMapTab = ARRAY[0..1] OF CMapRec; { model of CSeg Map }
  81.  
  82.   { The Records below provide access to the CONST DSeg Map }    {.cp12}
  83.  
  84.     DMapRecPtr = ^DMapRec;
  85.     DMapRec = RECORD
  86.         DSegWd0 : Word;    { purpose is unknown              }
  87.         DSegCnt : Word;    { byte count of data block        }
  88.         DSegRel : Word;    { byte count of data Relo List    }
  89.         DSegOwn : LL;      { To owner scope                  }
  90.     END; {DMapRec}
  91.  
  92.     DMapTabPtr = ^DMapTab;
  93.     DMapTab = ARRAY[0..1] OF DMapRec;    { model of DSeg Map }
  94.  
  95.   { The Record below is one entry in the Fix-Up List }            {.CP13}
  96.  
  97.     FixUpRecPtr = ^FixUpRec;
  98.     FixUpRec = RECORD
  99.         FixDnr : Byte;    { Donor Unit Offset }
  100.         FixFlg : Byte;    { Entry Format Flag }
  101.         FixWd1 : Word;    { Offset to Map Table  }
  102.         FixWd2 : Word;    { Effective Address Adjuster  }
  103.         FixOfs : Word;    { offset to patch point in code/data block }
  104.     END; {FixUpRec}
  105.  
  106.     FixUpPtr  = ^FixUpList;
  107.     FixUpList = ARRAY[0..1] OF FixUpRec; { model of Fix-Up List }
  108.  
  109.   { The Record below maps the Dictionary Header in Turbo Units } {.CP08}
  110.  
  111.     DNamePtr = ^ DNameRec;
  112.     DNameRec = RECORD
  113.         HLink : LL;         { Hash Chain Link; Resolves Collisions }
  114.         DForm : Char;       { Symbol Type; See StubRecord for types}
  115.         DSymb : LexNam;     { Worst-Case Symbol Size (UPPER-CASE)  }
  116.     END; {DNameRec}
  117.  
  118.   { The Record Below maps the Dictionary Stubs in Turbo Units  } {.CP10}
  119.  
  120.   DStubPtr = ^ DStubRcd;
  121.   DStubRcd = RECORD
  122.       CASE Char OF
  123.  
  124.       'P': (                     { --- For Untyped Constants --- }
  125.            sPTD : LG;            { to type descriptor            }
  126.            sPV1 : Word;          { value of constant - LO Word   }
  127.            sPV2 : Word);         { (size varies)     - HI Word   }
  128.  
  129.       'Y': (                     { ----- For UNIT Entries ------ }  {.CP05}
  130.            sYW1 : Word;          { unknown use; normally zero    }
  131.            sYCS : Word;          { Speculate Signature Word      }
  132.            sYNU : LL;            { to next Unit in List (SUCC)   }
  133.            sYPU : LL);           { to prior Unit in List (PRED)  }
  134.  
  135.       'O',                       { ---- Label Declaratives ----- }  {.CP05}
  136.       'T',                       { ---- Standard Procedures ---- }
  137.       'U',                       { ---- Standard Functions  ---- }
  138.       'V': (                     { ---- Standard "NEW" F/P  ---- }
  139.            sVxx : Word);         { semantics not precisely known }
  140.  
  141.       'W': (                     { ------- Standard Ports ------ }  {.CP02}
  142.            sWxx : Byte);         { 0=Byte Array, 1=Word Array    }
  143.  
  144.       'Q',                       { -------- Named Types -------- }  {.CP03}
  145.       'X': (                     { ----- External Variables ---- }
  146.            sQTD : LG);           { to type descriptor            }
  147.  
  148.       'S': (                     { ------ User Subprograms ----- }  {.CP20}
  149.             sSTp : BYte;         { 76543210  - Bit encoded       }
  150.                                  { .......1 = FAR Call Model     }
  151.                                  { ......1. = INLINE Declarative }
  152.                                  { .....1.. = INTERRUPT Routine  }
  153.                                  { ....1... = .OBJ module code   }
  154.                                  { ...1.... = METHOD (Any)       }
  155.                                  { .011.... = Constructor METHOD }
  156.                                  { .101.... = Destructor  METHOD }
  157.                                  { 1....... = ASSEMBLER attribute}
  158.             sSxx : Byte;         { function unknown at present   }
  159.             sSPM : Word;         { Code byte count if INLINE,    }
  160.                                  { else, offset to PROC Map      }
  161.             sSPS : LL;           { to containing scope or zero   }
  162.             sSHT : LL;           { to local scope hash table     }
  163.             sSVM : Word);        { VMT Offset-VIRTUAL Method PTR }
  164.  
  165.             { Notes: "sSVM" is followed immediately by a Type    }
  166.             {        Descriptor ($06).  INLINE Declarative code  }
  167.             {        Bytes then follow (if any).                 }
  168.  
  169.       'R': (                     { -- Variable, Field, Object  -- } {.CP35}
  170.             sRAM : Byte;         {   allocation method codes:      }
  171.                                  { $00 = Global Variables in DS    }
  172.                                  { $01 = Typed Constants  in DS    }
  173.                                  { $02 = VAR-BP based-Nested Scope }
  174.                                  { $03 = Absolute[Segment:Offset]  }
  175.                                  { $06 = SELF Parameter-ADDR Stack }
  176.                                  { $08 = Allocate in Record/Object }
  177.                                  { $10 = Absolute Equivalence      }
  178.                                  { $22 = VALUE Parameter-BP based  }
  179.                                  { $26 = VAR   Parameter-BP based  }
  180.  
  181.             sRVF : Longint;      { See VarStub Below               }
  182.             sRTD : LG);          { to Type Descriptor              }
  183.  
  184.       END;
  185.  
  186.   VarStubPtr = ^VarStub;
  187.   VarStub    = RECORD
  188.             Case  Byte Of  { sRAM Byte in Type "R" Stub }
  189.             $02,$06,
  190.             $22,$26:     (ROfs : Word;  { allocation offset (BP)  }
  191.                           ROB  : Word); { To Parent Scope/Zero    }
  192.  
  193.             $00,$01:     (TOfs : Word;  { allocation offset in map}
  194.                           TOB  : LL);   { offset in VAR/CONST Map }
  195.  
  196.             $03:         (AOfs : Word;  { Absolute Byte Offset    }
  197.                           ASeg : Word); { Absolute Segment Adr    }
  198.  
  199.             $08:         (Bofs : Word;  { Offset-Record Relative  }
  200.                           RChn : LL);   { To Next Field/Method    }
  201.  
  202.             $10:         (QLG  : LG);   { to Stub of Allocator    }
  203.   End;
  204.  
  205.   { The Record below maps a Formal Parameter List Entry }        {.CP08}
  206.  
  207.   FormalParmRcd = RECORD
  208.        fPTD : LG;        { to type descriptor for parameter  }
  209.        fPAM : Byte;        { passing model; 2=Value, 6=Address }
  210.      END;
  211.  
  212.   InlineLst = ARRAY[0..1] OF Word;        { model of INLINE code }
  213.  
  214.  
  215.   { The Record below maps the Type Descriptors in Turbo Units  } {.CP08}
  216.  
  217.   TypePtr   = ^TypeRecd;
  218.   TypeRecd  = RECORD
  219.        tpTC : Byte;        { Identifies the Variant Part }
  220.        tpTQ : Byte;        { Type Qualifier              }
  221.        tpSW : Word;        { Storage Width in Bytes      }
  222.        tpML : Word;             { Next Method if tpTC=$06     }
  223.  
  224.        CASE Byte OF                                                 {.CP04}
  225.     $00,            { For NULL or Un-Typed Variables }
  226.     $0A,            { For COMP,DOUBLE,EXTENDED,SINGLE }
  227.     $0B : ();        { -------- For REAL Type -------- }
  228.  
  229.     $01 : (            { ------ For ARRAY Types ------- }  {.CP04}
  230.         BaseType : LG;    { to TypeRecd for item arrayed   }
  231.         BounDesc : LG;    { to TypeRecd for array bounds   }
  232.               );
  233.  
  234.     $02 : (            { ------ For RECORD Types ------ }  {.CP04}
  235.         RecdHash : LL;    { to Hash Table for Field List   }
  236.         RecdDict : LL;    { to Field List Dictionary Begin }
  237.               );
  238.  
  239.     $03 : (            { ------ For OBJECT Types ------ }  {.CP15}
  240.         ObjtHash : LL;    { to Fields & Methods Hash Table }
  241.         ObjtDict : LL;    { to Fields & Methods Dictionary }
  242.         ObjtOwnr : LG;    { to Parent Object Type Descript }
  243.         ObjtVMTs : Word;{ Size of VMT if Virtual Methods }
  244.         ObjtDMap : Word;{ Data Map Offset of VMT Template}
  245.         ObjtVMTO : Word;{ object instance offset to VMT  }
  246.                 { pointer; $FFFF if object has   }
  247.                 { no Virtual Methods (no VMT)    }
  248.         ObjtName : LL;    { to Object Dictionary Header    }
  249.                 ObjtRes0,       { Usually $FFFF - Role Unknown   }
  250.                 ObjtRes1,       { Usually zero  - Role Unknown   }
  251.                 ObjtRes2,       { Usually zero  - Role Unknown   }
  252.                 ObjtRes3 : Word { Usually zero  - Role Unknown   }
  253.               );
  254.  
  255.     $04,            { ----- For FILE except TEXT ----}  {.CP04}
  256.     $05:  (            { ----- For TEXT file type ----- }
  257.         FileType : LG;    { to TypeRecd for Base File Type }
  258.               );
  259.     $06:  (            { ----- For Procedure Types ---- }  {CP05}
  260.         PFRes : LG;    { to Function Result TD / zero   }
  261.         PNPrm : Word;    { Formal Parameter Count/ zero   }
  262.                 PFPar : ARRAY[1..2] OF FormalParmRcd { model only}
  263.               );
  264.     $07 : (            { ------- For SET Types -------- } {.CP03}
  265.         SetBase  : LG;    { to base type descriptor of set }
  266.               );
  267.     $08 : (            { ----- For POINTER Types ------ } {.CP03}
  268.         PtrBase  : LG;    { to base type descriptor        }
  269.               );
  270.     $09 : (            { ------ For STRING Types ------ } {.CP04}
  271.         StrBase  : LG;    { to SYSTEM.CHAR type descriptor }
  272.         StrBound : LG;    { to array bounds for string typ }
  273.               );
  274.     $0C,         { For BYTE,INTEGER,LONGINT,SMALLINT,WORD }{.CP15}
  275.     $0D,            { ------- For BOOLEAN Type ------ }
  276.     $0E,            { ------- For CHAR Type --------- }
  277.     $0F : (            { ---- For Enumerated Types ----- }
  278.         LoBnd : LongInt;{ lower bound of subrange         }
  279.         HiBnd : LongInt;{ upper bound of subrange         }
  280.         Cmpat : LG;    { to upward compatible Type desc  }
  281.               );
  282.  
  283.         { The Enumeration Type Descriptor is immediately  }
  284.         { followed by a SET Type Descriptor ($07) but we  }
  285.         { don't know what this achieves.  Its base type   }
  286.         { LG points to the Enumerated Type Descriptor.    }
  287.  
  288.        END;  { TypeRecd }
  289.  
  290.  
  291.   { The Record below is a model Hash Table }                         {.CP07}
  292.  
  293.     HashPtr   = ^HashTable;
  294.     HashTable = RECORD
  295.         Bas : Word;                { Base and Max Offset in Slt }
  296.         Slt : ARRAY[0..1] Of LL;   { Slots in Hash Table        }
  297.     END;
  298.  
  299.   { The Record below is an entry in the Unit Code/Data Donor List } {.CP07}
  300.  
  301.     UDonorPtr = ^UDonorRec;
  302.     UDonorRec = RECORD
  303.         UDExxx : Word;
  304.         UDEnam : String[8]
  305.     END;
  306.  
  307.   { The Record below is an entry in the Source File List }            {.CP10}
  308.  
  309.     SrcFilePtr = ^SrcFileRec;
  310.     SrcFileRec = RECORD
  311.         SrcFlag : Byte;        { 4=.PAS file, 3=.INC, 5=.OBJ       }
  312.         SrcPad  : Word;        { no apparent use - always zero ?   }
  313.         SrcTime : Word;        { File Time Stamp if SrcFlag=3 or 4 }
  314.         SrcDate : Word;        { File Date Stamp if SrcFlag=3 or 4 }
  315.         SrcName : SrcNam;    { Varying length FileName.Extn      }
  316.     END;
  317.  
  318.   { The Record below is an entry in the Trace Table      }          {.CP12}
  319.  
  320.     TraceRecPtr = ^TraceRec;
  321.     TraceRec    = RECORD
  322.         TrName : LL;     { to Directory Entry of Proc/Method  }
  323.         TrFill : Word;     { to proc source file                }
  324.         TrPfx  : Word;     { bytes of data in front of code     }
  325.         TrBeg  : Word;     { Line Number of BEGIN Stmt          }
  326.         TrLNos : Word;     { Lines of Code to Execute in TRACE  }
  327.         TrExec : ARRAY[1..2] { Model Array of bytes that map each }
  328.              OF Byte;     { line of code to be traced by DEBUG }
  329.     END;
  330.  
  331.   BufPtr = ^Buffer;                                             {.CP06}
  332.   Buffer = RECORD               { General Buffer Mapping }
  333.     CASE Boolean OF
  334.       True :( BufByt : AryB);   { Byte Array over Buffer }
  335.       False:( BufWrd : AryW);   { Word Array over Buffer }
  336.     END;
  337.  
  338. VAR  BufPtrJob : BufPtr;
  339.  
  340. PROCEDURE InitJobUnit(FilNam:Dos.PathStr);                      {.CP27}
  341. PROCEDURE DropJobUnit;
  342. FUNCTION  PtrAdjust(Arg : Pointer; Adj: Word):Pointer;
  343. FUNCTION  FormLL(Base,Ceil:Pointer):LL;
  344. FUNCTION  HexB(Arg:byte):Str2;
  345. FUNCTION  HexW(Arg:Word):Str4;
  346. FUNCTION  IsSystemUnit(U : UnitPtr): Boolean;
  347. FUNCTION  AddrStub(arg : DNamePtr):DStubPtr;
  348. FUNCTION  AddrHash(U : UnitPtr; Hash : LL): HashPtr;
  349. FUNCTION  AddrDict(U : UnitPtr; Hash : LL): DNamePtr;
  350. FUNCTION  AddrType(U : UnitPtr; TypeLG : LG):TypePtr;
  351. FUNCTION  AddrProcType(S : DStubPtr):TypePtr;
  352. FUNCTION  AddrNxtSrc(U : UnitPtr; Arg : SrcFilePtr):SrcFilePtr;
  353. FUNCTION  AddrSrcTabOff(U : UnitPtr; Offset : Word):SrcFilePtr;
  354. FUNCTION  CountPMapSlots(U : UnitPtr):Integer;
  355. FUNCTION  AddrPMapTab(U : UnitPtr):PMapPtr;
  356. FUNCTION  CountCMapSlots(U : UnitPtr):Integer;
  357. FUNCTION  AddrCMapTab(U : UnitPtr):CMapTabPtr;
  358. FUNCTION  CountDMapSlots(U : UnitPtr):Integer;
  359. FUNCTION  AddrDMapTab(U : UnitPtr):DMapTabPtr;
  360. FUNCTION  AddrTraceTab(U : UnitPtr):TraceRecPtr;
  361. FUNCTION  GetTrExecSize(T : TraceRecPtr):Integer;
  362. FUNCTION  AddrNxtTrace(U : UnitPtr; T : TraceRecPtr):TraceRecPtr;
  363. FUNCTION  AddrFixUps(U : UnitPtr):FixUpPtr;
  364. FUNCTION  AddrLGUnit(U : UnitPtr; TypeLG : LG):DNamePtr;
  365. FUNCTION  Public(Arg : Char) : Char;
  366. FUNCTION  PtrNormal(P : Pointer) : Pointer;
  367. (**********************)                                        {.CP24}
  368. (**) IMPLEMENTATION (**)
  369. (**********************)
  370.  
  371. TYPE
  372.  
  373.   Fstats = RECORD
  374.     Size : Longint;
  375.     Path : Dos.PathStr;
  376.   END;
  377.  
  378. CONST
  379.  
  380.   TurboId6  : HdrAry = 'TPU9';
  381.   NullOfs   : Word   = $FFFF;
  382.  
  383. VAR
  384.  
  385.   TPFile    : File;
  386.   SizRefBfr,
  387.   SizJobBfr : Word;
  388.   BufPtrRef : BufPtr;
  389.  
  390.   JobPath   : Dos.PathStr;
  391.  
  392.   { Function Below Converts PRIVATE Names to PUBLIC }           {.CP04}
  393.  
  394. FUNCTION Public(Arg : Char) : Char;
  395. BEGIN Public := Chr(Ord(Arg) AND $7F) END;
  396.  
  397.   { Function Below Converts POINTER to Normalized Form }        {.CP18}
  398.  
  399. FUNCTION  PtrNormal(P : Pointer) : Pointer;
  400. Var I, J : Word;
  401. Begin
  402.    I := Seg(P^); J := Ofs(P^);
  403.    ASM
  404.       MOV   AX,J        { get OFFSET }
  405.       ADD   AX,7        { round up to QWORD }
  406.       MOV   BX,00008h   { set AND mask for offset }
  407.       AND   BX,AX       { normalize new offset }
  408.       MOV   J,BX        { save normalized offset }
  409.       MOV   CX,4        { load shift width  }
  410.       SHR   AX,CL       { drop offset digit }
  411.       ADD   I,AX        { normalize segment }
  412.    End;
  413.    PtrNormal := Ptr(I,J)
  414. End;
  415.  
  416.   { Procedure Below Traps Pointer Violations }            {.CP10}
  417.  
  418. PROCEDURE CheckPtrs(U,V:Pointer);
  419. BEGIN
  420.     IF (U = Nil) OR (V = Nil) OR (Seg(U^) <> Seg(V^)) THEN
  421.     BEGIN
  422.         WriteLn('Pointer Violation in CheckPtrs');
  423.         Halt(1)
  424.     END
  425. END; {CheckPtrs}
  426.  
  427.   { Function Below Computes an LL from two Pointers }           {.CP09}
  428.  
  429. FUNCTION  FormLL(Base,Ceil:Pointer):LL;
  430. BEGIN
  431.     CheckPtrs(Base,Ceil);
  432.     IF Ofs(Base^) > Ofs(Ceil^)
  433.         THEN FormLL := LL(Ofs(Base^)-Ofs(Ceil^))
  434.         ELSE FormLL := LL(Ofs(Ceil^)-Ofs(Base^));
  435. END;
  436.  
  437.   { Function Below Adjusts Pointer Values by Offsets }           {.CP04}
  438.  
  439. FUNCTION  PtrAdjust(Arg : Pointer; Adj: Word):Pointer;
  440. BEGIN     PtrAdjust := Ptr(Seg(Arg^),Ofs(Arg^) + Adj)     END;
  441.  
  442.   { Function Below Checks to See if Unit Name is "SYSTEM" }
  443.  
  444. FUNCTION  IsSystemUnit(U : UnitPtr): Boolean;
  445. BEGIN
  446.    IsSystemUnit := DNamePtr(Ptr(Seg(U^),Ofs(U^)+U^.UHUDH))^.DSymb = 'SYSTEM'
  447. END;
  448.  
  449.   { Function Below Finds The Stub Belonging to a Dictionary Header } {.CP05}
  450.  
  451. FUNCTION  AddrStub(Arg : DNamePtr):DStubPtr;
  452. CONST PrefixSize = SizeOf(LL)+SizeOf(Char) + 1;
  453. BEGIN  AddrStub := PtrAdjust(Arg,PrefixSize + Ord(Arg^.DSymb[0]))  END;
  454.  
  455.   { Function Below Gets Pointer to Hash Table }                  {.CP04}
  456.  
  457. FUNCTION  AddrHash(U : UnitPtr; Hash : LL): HashPtr;
  458. BEGIN   AddrHash := HashPtr(PtrAdjust(U,Hash))  END;
  459.  
  460.   { Function Below Gets Pointer to Dictionary Entry using LL }   {.CP04}
  461.  
  462. FUNCTION  AddrDict(U : UnitPtr; Hash : LL): DNamePtr;
  463. BEGIN AddrDict := DNamePtr(PtrAdjust(U,Hash)) END;
  464.  
  465.   { Function Below Gets Pointer to Type Descriptor if Local to Unit } {.CP12}
  466.  
  467. FUNCTION  AddrType(U : UnitPtr; TypeLG : LG):TypePtr;
  468. VAR D:DNamePtr; S:DStubPtr; R:LL;
  469. BEGIN
  470.     D := AddrDict(U,U^.UHUDH);      {point to our unit DE}
  471.     S := AddrStub(D);               {point to its stub   }
  472.     R := FormLL(U,S);               {get offset to stub  }
  473.     IF R = TypeLG.UntId             {if offset matches   }
  474.     THEN AddrType := TypePtr(PtrAdjust(U,TypeLG.UntLL))
  475.     ELSE AddrType := Nil
  476. END;
  477.  
  478.   { Function Below Gets Pointer to Unit Descriptor for Type via LG } {.CP21}
  479.  
  480. FUNCTION  AddrLGUnit(U : UnitPtr; TypeLG : LG):DNamePtr;
  481. VAR D:DNamePtr; S:DStubPtr; R:LL;
  482. BEGIN
  483.     D := AddrDict(U,U^.UHUDH);      {point to our unit hdr}
  484.     S := AddrStub(D);               {point to our stub    }
  485.     R := FormLL(U,S);               {get offset to stub   }
  486.     IF (R <> 0) THEN
  487.     IF (TypeLG.UntID <> R) THEN     {if offsets don't match }
  488.     REPEAT
  489.        D := AddrDict(U,S^.sYNU);            {chain to next DE}
  490.        IF D^.DForm <> 'Y' THEN R := 0 ELSE  {if next is unit }
  491.        BEGIN
  492.          S := AddrStub(D);                  {its stub address}
  493.          R := FormLL(U,S);                  {and stub offset }
  494.        END;
  495.     UNTIL (R = TypeLG.UntID) OR (R = 0);    {match of end list  }
  496.     IF R <> 0 THEN AddrLGUnit := D          {we had a match     }
  497.               ELSE AddrLGUnit := Nil;       {we couldn't find it}
  498. END;
  499.  
  500.   { Function Below Gets Pointer to Procedure Stub Type Descriptor }{.CP04}
  501.  
  502. FUNCTION  AddrProcType(S : DStubPtr):TypePtr;
  503. BEGIN AddrProcType := TypePtr(PtrAdjust(@S^.sSVM,SizeOf(S^.sSVM))) END;
  504.  
  505.   { Function Below Gets Pointer to Next Entry in Source File List } {.CP21}
  506.  
  507. FUNCTION  AddrNxtSrc(U : UnitPtr; Arg : SrcFilePtr):SrcFilePtr;
  508. VAR J : LL;  S : SrcFilePtr;
  509. BEGIN
  510.     J := 0;
  511.     IF Arg = Nil THEN AddrNxtSrc := Nil ELSE
  512.     BEGIN
  513.        J := FormLL(U,Arg);
  514.        IF J < U^.UHLSF
  515.        THEN AddrNxtSrc := Nil ELSE
  516.        IF NOT (J < U^.UHDBT)
  517.        THEN AddrNxtSrc := Nil ELSE
  518.        BEGIN
  519.           S := SrcFilePtr(PtrAdjust(Arg,8 + Ord(Arg^.SrcName[0])));
  520.           IF FormLL(U,S) < U^.UHDBT
  521.           THEN AddrNxtSrc := S
  522.           ELSE AddrNxtSrc := Nil
  523.        END
  524.     END
  525. END;
  526.  
  527.   { Function Below Gets Pointer to Source File List Entry at Offset }{.CP09}
  528.  
  529. FUNCTION  AddrSrcTabOff(U : UnitPtr; Offset : Word):SrcFilePtr;
  530. BEGIN
  531.     WITH U^ DO
  532.     IF (UHLSF+Offset) < UHDBT
  533.     THEN AddrSrcTabOff := SrcFilePtr(PtrAdjust(U,UHLSF+Offset))
  534.     ELSE AddrSrcTabOff := Nil
  535. END;
  536.  
  537.   { Function Counts Number of Slots in PROC Map Table }            {.CP06}
  538.  
  539. FUNCTION  CountPMapSlots(U : UnitPtr):Integer;
  540. BEGIN
  541.     CountPMapSlots := (U^.UHCMT-U^.UHPMT) DIV SizeOf(PMapRec);
  542. END;
  543.  
  544.   { Function Gets Address of PROC Map Table }                      {.CP08}
  545.  
  546. FUNCTION  AddrPMapTab(U : UnitPtr):PMapPtr;
  547. BEGIN
  548.     IF CountPMapSlots(U) > 0
  549.     THEN AddrPMapTab := PMapPtr(PtrAdjust(U,U^.UHPMT))
  550.     ELSE AddrPMapTab := Nil
  551. END;
  552.  
  553.   { Function Counts Number of Slots in CSeg Map Table }         {.CP06}
  554.  
  555. FUNCTION  CountCMapSlots(U : UnitPtr):Integer;
  556. BEGIN
  557.     WITH U^ DO CountCMapSlots := (UHTMT-UHCMT) DIV SizeOf(CMapRec);
  558. END;
  559.  
  560.   { Function Gets Address of CSeg Map Table }                   {.CP08}
  561.  
  562. FUNCTION  AddrCMapTab(U : UnitPtr):CMapTabPtr;
  563. BEGIN
  564.     IF CountCmapSlots(U) > 0
  565.     THEN AddrCMapTab := CMapTabPtr(PtrAdjust(U,U^.UHCMT))
  566.     ELSE AddrCMapTab := Nil
  567. END;
  568.  
  569.   { Function Counts Number of DSeg Map Slots }                  {.CP06}
  570.  
  571. FUNCTION  CountDMapSlots(U : UnitPtr):Integer;
  572. BEGIN
  573.     WITH U^ DO CountDMapSlots := (UHDMT - UHTMT) DIV SizeOf(DMapRec)
  574. END;
  575.  
  576.   { Function Gets Address of DSeg Map Table }                   {.CP08}
  577.  
  578. FUNCTION  AddrDMapTab(U : UnitPtr):DMapTabPtr;
  579. BEGIN
  580.     IF CountDMapSlots(U) > 0
  581.     THEN AddrDMapTab := DMapTabPtr(PtrAdjust(U,U^.UHTMT))
  582.     ELSE AddrDMapTab := Nil
  583. END;
  584.  
  585.   { Function Below Gets Pointer to 1st Trace Table Entry or Nil }  {.CP08}
  586.  
  587. FUNCTION  AddrTraceTab(U : UnitPtr):TraceRecPtr;
  588. BEGIN
  589.     IF U^.UHDBT = U^.UHENC
  590.     THEN AddrTraceTab := Nil
  591.     ELSE AddrTraceTab := TraceRecPtr(PtrAdjust(U,U^.UHDBT))
  592. END; {AddrTraceTab}
  593.  
  594.    { Function Below Gets Byte Count in TrExec Array }      {.CP20}
  595.  
  596. FUNCTION GetTrExecSize(T : TraceRecPtr):Integer;
  597. VAR i,k : Integer;
  598. BEGIN
  599.    IF T = Nil THEN GetTrExecSize := 0 ELSE
  600.    BEGIN
  601.       k := T^.TrLNos;                   {number of lines in array}
  602.       i := 1;                           {prime scan line number  }
  603.       WHILE i <= k DO BEGIN             {still have lines to test}
  604.          IF T^.TrExec[i] = $80 THEN     {if "escape byte" present}
  605.      BEGIN
  606.        Inc(k);                      {bump array limit        }
  607.        Inc(i)                       {bump to byte count slot }
  608.      END;
  609.      Inc(i)                         {check next slot         }
  610.       END;
  611.       GetTrExecSize := k;               {final byte count        }
  612.    END;
  613. END;
  614.  
  615.   { Function Below Gets Pointer to next Trace Table Entry or Nil }  {.CP14}
  616.  
  617. FUNCTION  AddrNxtTrace(U : UnitPtr; T : TraceRecPtr):TraceRecPtr;
  618. VAR k : Integer;
  619. BEGIN
  620.     IF T = Nil THEN AddrNxtTrace := Nil ELSE
  621.     BEGIN
  622.         k := GetTrExecSize(T);
  623.         T := TraceRecPtr(PtrAdjust(@T^.TrExec[1],LL(k)));
  624.         IF FormLL(U,T) >= U^.UHENC
  625.             THEN AddrNxtTrace := Nil
  626.             ELSE AddrNxtTrace := T
  627.     END
  628. END; {AddrNxtTrace}
  629.  
  630.   { Function Below Gets Pointer to 1st Fixup Table Entry or Nil }  {.CP13}
  631.  
  632. FUNCTION  AddrFixUps(U : UnitPtr):FixUpPtr;
  633. VAR j : Word;
  634. BEGIN
  635.     IF U^.UHZFA = 0 THEN AddrFixUps := Nil ELSE
  636.     WITH U^ DO BEGIN
  637.         j := (UHENC  + $F) AND $FFF0;
  638.         j := (UHZCS  + $F) AND $FFF0 + j;
  639.         j := (UHZDT  + $F) AND $FFF0 + j;
  640.         AddrFixUps := Ptr(Seg(U^),Ofs(U^) + j)
  641.     END
  642. END; {AddrFixUps}
  643.  
  644.   { Function Below Converts a byte to Printable Hex }               {.CP05}
  645.  
  646. FUNCTION HexB(arg:byte): Str2;
  647. CONST HexTab : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  648. BEGIN HexB := HexTab[arg SHR 4] + HexTab[arg AND $F] END;
  649.  
  650.   { Function Below Converts a Word to Printable Hex in Dump Mode }  {.CP04}
  651.  
  652. FUNCTION HexW(arg:Word): Str4;
  653. BEGIN HexW := HexB(HI(arg)) + HexB(LO(arg)) END;
  654.  
  655. PROCEDURE FindFile(FName : String; VAR Finding : FStats);        {.CP14}
  656. CONST AttrMask = Dos.Archive + Dos.ReadOnly + Dos.SysFile;
  657. VAR   S : Dos.SearchRec; P : Dos.DirStr; N : Dos.NameStr; X : Dos.ExtStr;
  658. BEGIN
  659.     Finding.Size := -1;
  660.     FSplit(FName,P,N,X);
  661.     IF (X = '') OR (X = '.') THEN X := '.TPU';
  662.     Finding.Path := FSearch(N + X,GetEnv('PATH'));
  663.     IF Finding.Path <> '' THEN
  664.     BEGIN
  665.         FindFirst(Finding.Path,AttrMask,S);
  666.         IF DosError = 0 THEN Finding.Size := S.Size
  667.     END
  668. END;
  669.  
  670. PROCEDURE OpenUnit(Path : String);                               {.CP07}
  671. BEGIN
  672.    {I-}
  673.         Assign(TPFile , Path);
  674.         Reset(TPFile,1);
  675.    {$I+}
  676. END;
  677.  
  678. PROCEDURE CloseUnit;                                             {.CP05}
  679. BEGIN
  680.     {$I-} Close(TPFile); {$I+}
  681.     IF IOResult <> 0 THEN;
  682. END;
  683.  
  684. PROCEDURE InitJobUnit(FilNam:Dos.PathStr);                      {.CP14}
  685. VAR W : FStats;
  686. BEGIN
  687.     DropJobUnit;
  688.     FindFile(FilNam,W);
  689.     IF (W.Size > 0) AND (W.Size < 65536) THEN
  690.     BEGIN
  691.         SizJobBfr := W.Size;
  692.         OpenUnit(W.Path);
  693.         GetMem(BufPtrJob,SizJobBfr);
  694.         BlockRead(TPFile,BufPtrJob^.BufByt,SizJobBfr);
  695.         CloseUnit;
  696.     END
  697. END;
  698.  
  699. PROCEDURE DropJobUnit;                                         {.CP11}
  700. BEGIN
  701.     IF BufPtrJob <> Nil THEN
  702.     BEGIN
  703.         FreeMem(BufPtrJob,SizJobBfr);
  704.         CloseUnit;
  705.     END;
  706.     BufPtrJob := Nil;
  707.     SizJobBfr := 0;
  708. END;
  709.  
  710. BEGIN    { UNIT INITIALIZATION CODE }                        {.CP10}
  711.  
  712.     SizRefBfr := 0;
  713.     SizJobBfr := 0;
  714.     JobPath   := '';
  715.     BufPtrRef := Nil;
  716.     BufPtrJob := Nil;
  717.  
  718. END.
  719.